Aaron Shaffer
May 3, 2017
“10.7: Adaptive Sampling: Suppose that we had a rectangular forest for which you wish to estimate the number of trees of a certain species. One way to accomplish this is to lay a grid over the forest a sample a certain number of cells. But suppose that these trees tend to occur in clusters so that if you see one tree in a cell then you are likely to see other trees in nearby cells. Why not visit these neighboring cells while in the other? This is an example of adaptive sampling. Instead of a sample size being selected in advance and being fixed the sample size is allowed to vary as new information is coming in.”
An unbiased estimator of the mean density per cell in the population is given by:
\(\hat{\mu} = \frac{1}{n}\sum\limits_{i=1}^{n}{\frac{y_i}{m_i}} = \frac{1}{n}\sum\limits_{i=1}^{n}{\bar{y_i}}\)
Which is the means of the network means. The estimated variance of this estimator is what you would expect from simple random sampling.
\(\hat{V}(\hat{\mu}) = (1 - \frac{n}{N}) \frac{s_\bar{y}^2}{n}\)
Where: \(\frac{s_\bar{y}^2}{n}\)
is the sample variance of the network means
ie: \(s_\bar{y}^2 = var(\frac{y_i}{m_i})\)
In R:
mu.hat <- 1/n * sum(y/m)
s.ybar.2 <- var(y/m)
V.hat.mu.hat <- (1 - n/N) * s.ybar.2/n\(n = 5\)
\(N = 100\)
| \(m_i\) | 1 | 4 | 1 | 5 | 2 |
| \(y_i\) | 0 | 12 | 1 | 15 | 7 |
\(\hat{\mu} = \frac{1}{5}\sum{(\frac{0}{1} + \frac{12}{4} + \frac{1}{1} + \frac{15}{5} + \frac{7}{2})} = 2.1\)
\(s_\bar{y}^2 = var(\frac{y}{m}) = 2.3\)
\(\hat{V}(\hat{\mu}) = (1 - \frac{5}{100}) \frac{2.3}{5} = 0.437\)
n <- 5
N <- 100
m <- c(1,4,1,5,2)
y <- c(0,12,1,15,7)adaptive.sample.confint.fun <- function(y,m,n,N) {
mu.hat <- 1/n * sum(y/m)
s.y.2 <- var(y/m)
v.mu <- (1 - n/N) * s.y.2/n
c("mu.hat" = mu.hat,
"s.y.2" = s.y.2,
"v.mu" = v.mu,
"var" = 2 * sqrt(v.mu),
"lower" = mu.hat - 2 * sqrt(v.mu),
"upper" = mu.hat + 2 * sqrt(v.mu))
}
adaptive.sample.confint.fun(y,m,n,N)## mu.hat s.y.2 v.mu var lower upper
## 2.1000000 2.3000000 0.4370000 1.3221195 0.7778805 3.4221195
So for this sample we estimate that the true mean density of our network was between 0.77 and 3.42 Maple Trees per cell
Data Structure: 2d Matrix
in R: ?matrix
Hint: “lay a grid over the forest”
example.world <- matrix(c( 1, 0, 3, 3, 0, 0,-1,
0, 0, 3, 0, 3, 0,-1,
3, 0, 0, 0, 0, 0, 0,
0, 4, 0, 0, 0, 3, 3,
0, 0, 0, 3, 3, 3, 0,
-1,-1, 0, 0, 0, 0, 0,
-1,-1,-1,-1,-1,-1,-1),
nrow = 7, ncol = 7,byrow=TRUE)
example.world## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] 1 0 3 3 0 0 -1
## [2,] 0 0 3 0 3 0 -1
## [3,] 3 0 0 0 0 0 0
## [4,] 0 4 0 0 0 3 3
## [5,] 0 0 0 3 3 3 0
## [6,] -1 -1 0 0 0 0 0
## [7,] -1 -1 -1 -1 -1 -1 -1
If you want to rebuild a world given some adaptive samples:
Think of a world like a game of minesweeper.
Since we know the y and m for a few samples we know a couple of things. Anything around these samples has to have a value of 0, as defined by what it means to take an adaptive sample.
Any square in the representation of the world that doesnt touch a known sample has some unknown value “-1”
First lets look at another example world:
figure10.2 <- matrix(rep(rep(0,10),10),
nrow = 10, ncol = 10)
figure10.2[,10] <- c(4,0,0,0,0,0,0,0,0,7)
figure10.2[,9] <- c(3,0,2,1,0,0,0,0,4,1)
figure10.2[,8] <- c(0,0,0,4,5,0,0,3,2,0)
figure10.2[,7] <- c(5,4,0,0,0,0,0,0,0,0)
figure10.2[,6] <- c(0,0,0,2,0,1,0,0,7,0)
figure10.2[,5] <- c(0,5,0,4,0,0,0,0,0,0)
figure10.2[,4] <- c(0,0,3,0,0,4,0,3,0,0)
figure10.2[,3] <- c(0,1,0,0,0,3,0,0,4,0)
figure10.2[,2] <- c(0,0,0,2,6,0,0,0,0,0)
figure10.2[,1] <- c(0,4,0,4,0,0,2,3,0,0)In order to navigate this worlds we first need to know a couple of definitions
“In graph theory and computer science and adjacency list is a collection of unordered lists used to represent a finite graph. Each list represents the set of neighbors of a vertex of a graph”
Three functions created
Adjlist function -> give it a world as a matrix object, gives you back and adjacency list
getEdges function -> give it a world as a matrix object, returns an adjacency list that the igraph package can use to create a graph
Adjlist.adaptive function -> given a world as a matrix object returns the adjacency list for a world that obeys the rules of an adaptive sampling grid
Core idea:
“column” up and down
“row” left and right
“%%” modulo, finds the remainder in a division
for each index "i" of the matrix:
- Is "i" in the Top Row?
"is top" - i > (nrow * ncol) - ncol
- Is "i" in the Bottom Row?
"is bottom" - i <= ncol
- Is "i" in the Leftmost column?
"is left" - (i - 1) %% ncol == 0
- Is "i" in the Rightmost Column?
- i %% ncol == 0
if (I'm not Leftmost column)
left <- i - 1
if (I'm not in the Leftmost column or Topmost row)
upleft <- i - 1 + ncol
if (I'm not in the Topmost Row)
up <- i + ncol
if (I'm not in the Topmost row or Rightmost column)
upright <- i + 1 + ncol
if (I'm not in the Rightmost column)
right <- i + 1
if (I'm not in the Bottommost row or the Rightmost column)
downright <- i + 1 - ncol
if (I'm not in the Bottommost row)
down <- i - ncol
plotly!, mouse over graphs for more information!
## [1] "ncol: 10"
## [1] "nrow: 10"
adjlist <- function(world){
nrow <- nrow(world)
ncol <- ncol(world)
G <- as.vector(world)
adj.list <- rep(list(c()),nrow*ncol)
for(index in 1:length(G)){
last.column <- index %% ncol == 0
first.column <- (index - 1) %% ncol == 0
first.row <- index <= ncol
last.row <- index > (nrow * ncol - ncol)
left <- ifelse(first.column,NA,index - 1)
up.left <- ifelse(last.row | first.column,NA,index + ncol - 1)
up <- ifelse(last.row,NA,index + ncol)
up.right <- ifelse(last.row | last.column, NA,index + ncol + 1)
right <- ifelse(last.column, NA, index + 1)
down.right <- ifelse(first.row | last.column, NA, index - ncol + 1)
down <- ifelse(first.row, NA, index - ncol)
down.left <- ifelse(first.row | first.column , NA, index - ncol - 1)
adjlist.i <- c()
if(!is.na(left))
adjlist.i <- c(adjlist.i,"W" = left)
if(!is.na(up.left))
adjlist.i <- c(adjlist.i,"NW" = up.left)
if(!is.na(up))
adjlist.i <- c(adjlist.i,"N" = up)
if(!is.na(up.right))
adjlist.i <- c(adjlist.i,"NE" = up.right)
if(!is.na(right))
adjlist.i <- c(adjlist.i,"E"= right)
if(!is.na(down.left))
adjlist.i <- c(adjlist.i,"SE" = down.left)
if(!is.na(down))
adjlist.i <- c(adjlist.i,"S" = down)
if(!is.na(down.right))
adjlist.i <- c(adjlist.i,"SW" = down.right)
adj.list[[index]] <- adjlist.i
}
return(adj.list)
}adjlist.adaptive <- function(world){
nrow <- nrow(world)
ncol <- ncol(world)
G <- as.vector(world)
adj.list <- rep(list(c()),nrow*ncol)
for(index in 1:length(G)){
if(G[index] != 0) {
last.column <- index %% ncol == 0
first.column <- (index - 1) %% ncol == 0
first.row <- index <= ncol
last.row <- index > (nrow * ncol - ncol)
left <- ifelse(first.column,NA,index - 1)
up.left <- ifelse(last.row | first.column,NA,index + ncol - 1)
up <- ifelse(last.row,NA,index + ncol)
up.right <- ifelse(last.row | last.column, NA,index + ncol + 1)
right <- ifelse(last.column, NA, index + 1)
down.right <- ifelse(first.row | last.column, NA, index - ncol + 1)
down <- ifelse(first.row, NA, index - ncol)
down.left <- ifelse(first.row | first.column , NA, index - ncol - 1)
to.return <- c()
if(!is.na(left)) {
if(G[left] != 0) {
to.return <- c(to.return,"W" = left)
}
}
if(!is.na(up.left)){
if(G[up.left] != 0) {
to.return <- c(to.return,"NW" = up.left)
}
}
if(!is.na(up)) {
if(G[up] != 0){
to.return <- c(to.return,"N" = up)
}
}
if(!is.na(up.right)) {
if(G[up.right] != 0){
to.return <- c(to.return,"NE" = up.right)
}
}
if(!is.na(right)) {
if(G[right] != 0){
to.return <- c(to.return,"E"= right)
}
}
if(!is.na(down.left)) {
if(G[down.left] != 0){
to.return <- c(to.return,"SE" = down.left)
}
}
if(!is.na(down)) {
if(G[down] != 0){
to.return <- c(to.return,"S" = down)
}
}
if(!is.na(down.right)) {
if(G[down.right] != 0){
to.return <- c(to.return,"SW" = down.right)
}
}
adj.list[[index]] <- to.return
} else {
adj.list[[index]] <- c("NA" = NA)
}
}
return(adj.list)
}figure10.2.adjlist <- adjlist(figure10.2)
figure10.2.adjlist## [[1]]
## N NE E
## 11 12 2
##
## [[2]]
## W NW N NE E
## 1 11 12 13 3
##
## [[3]]
## W NW N NE E
## 2 12 13 14 4
##
## [[4]]
## W NW N NE E
## 3 13 14 15 5
##
## [[5]]
## W NW N NE E
## 4 14 15 16 6
##
## [[6]]
## W NW N NE E
## 5 15 16 17 7
##
## [[7]]
## W NW N NE E
## 6 16 17 18 8
##
## [[8]]
## W NW N NE E
## 7 17 18 19 9
##
## [[9]]
## W NW N NE E
## 8 18 19 20 10
##
## [[10]]
## W NW N
## 9 19 20
##
## [[11]]
## N NE E S SW
## 21 22 12 1 2
##
## [[12]]
## W NW N NE E SE S SW
## 11 21 22 23 13 1 2 3
##
## [[13]]
## W NW N NE E SE S SW
## 12 22 23 24 14 2 3 4
##
## [[14]]
## W NW N NE E SE S SW
## 13 23 24 25 15 3 4 5
##
## [[15]]
## W NW N NE E SE S SW
## 14 24 25 26 16 4 5 6
##
## [[16]]
## W NW N NE E SE S SW
## 15 25 26 27 17 5 6 7
##
## [[17]]
## W NW N NE E SE S SW
## 16 26 27 28 18 6 7 8
##
## [[18]]
## W NW N NE E SE S SW
## 17 27 28 29 19 7 8 9
##
## [[19]]
## W NW N NE E SE S SW
## 18 28 29 30 20 8 9 10
##
## [[20]]
## W NW N SE S
## 19 29 30 9 10
##
## [[21]]
## N NE E S SW
## 31 32 22 11 12
##
## [[22]]
## W NW N NE E SE S SW
## 21 31 32 33 23 11 12 13
##
## [[23]]
## W NW N NE E SE S SW
## 22 32 33 34 24 12 13 14
##
## [[24]]
## W NW N NE E SE S SW
## 23 33 34 35 25 13 14 15
##
## [[25]]
## W NW N NE E SE S SW
## 24 34 35 36 26 14 15 16
##
## [[26]]
## W NW N NE E SE S SW
## 25 35 36 37 27 15 16 17
##
## [[27]]
## W NW N NE E SE S SW
## 26 36 37 38 28 16 17 18
##
## [[28]]
## W NW N NE E SE S SW
## 27 37 38 39 29 17 18 19
##
## [[29]]
## W NW N NE E SE S SW
## 28 38 39 40 30 18 19 20
##
## [[30]]
## W NW N SE S
## 29 39 40 19 20
##
## [[31]]
## N NE E S SW
## 41 42 32 21 22
##
## [[32]]
## W NW N NE E SE S SW
## 31 41 42 43 33 21 22 23
##
## [[33]]
## W NW N NE E SE S SW
## 32 42 43 44 34 22 23 24
##
## [[34]]
## W NW N NE E SE S SW
## 33 43 44 45 35 23 24 25
##
## [[35]]
## W NW N NE E SE S SW
## 34 44 45 46 36 24 25 26
##
## [[36]]
## W NW N NE E SE S SW
## 35 45 46 47 37 25 26 27
##
## [[37]]
## W NW N NE E SE S SW
## 36 46 47 48 38 26 27 28
##
## [[38]]
## W NW N NE E SE S SW
## 37 47 48 49 39 27 28 29
##
## [[39]]
## W NW N NE E SE S SW
## 38 48 49 50 40 28 29 30
##
## [[40]]
## W NW N SE S
## 39 49 50 29 30
##
## [[41]]
## N NE E S SW
## 51 52 42 31 32
##
## [[42]]
## W NW N NE E SE S SW
## 41 51 52 53 43 31 32 33
##
## [[43]]
## W NW N NE E SE S SW
## 42 52 53 54 44 32 33 34
##
## [[44]]
## W NW N NE E SE S SW
## 43 53 54 55 45 33 34 35
##
## [[45]]
## W NW N NE E SE S SW
## 44 54 55 56 46 34 35 36
##
## [[46]]
## W NW N NE E SE S SW
## 45 55 56 57 47 35 36 37
##
## [[47]]
## W NW N NE E SE S SW
## 46 56 57 58 48 36 37 38
##
## [[48]]
## W NW N NE E SE S SW
## 47 57 58 59 49 37 38 39
##
## [[49]]
## W NW N NE E SE S SW
## 48 58 59 60 50 38 39 40
##
## [[50]]
## W NW N SE S
## 49 59 60 39 40
##
## [[51]]
## N NE E S SW
## 61 62 52 41 42
##
## [[52]]
## W NW N NE E SE S SW
## 51 61 62 63 53 41 42 43
##
## [[53]]
## W NW N NE E SE S SW
## 52 62 63 64 54 42 43 44
##
## [[54]]
## W NW N NE E SE S SW
## 53 63 64 65 55 43 44 45
##
## [[55]]
## W NW N NE E SE S SW
## 54 64 65 66 56 44 45 46
##
## [[56]]
## W NW N NE E SE S SW
## 55 65 66 67 57 45 46 47
##
## [[57]]
## W NW N NE E SE S SW
## 56 66 67 68 58 46 47 48
##
## [[58]]
## W NW N NE E SE S SW
## 57 67 68 69 59 47 48 49
##
## [[59]]
## W NW N NE E SE S SW
## 58 68 69 70 60 48 49 50
##
## [[60]]
## W NW N SE S
## 59 69 70 49 50
##
## [[61]]
## N NE E S SW
## 71 72 62 51 52
##
## [[62]]
## W NW N NE E SE S SW
## 61 71 72 73 63 51 52 53
##
## [[63]]
## W NW N NE E SE S SW
## 62 72 73 74 64 52 53 54
##
## [[64]]
## W NW N NE E SE S SW
## 63 73 74 75 65 53 54 55
##
## [[65]]
## W NW N NE E SE S SW
## 64 74 75 76 66 54 55 56
##
## [[66]]
## W NW N NE E SE S SW
## 65 75 76 77 67 55 56 57
##
## [[67]]
## W NW N NE E SE S SW
## 66 76 77 78 68 56 57 58
##
## [[68]]
## W NW N NE E SE S SW
## 67 77 78 79 69 57 58 59
##
## [[69]]
## W NW N NE E SE S SW
## 68 78 79 80 70 58 59 60
##
## [[70]]
## W NW N SE S
## 69 79 80 59 60
##
## [[71]]
## N NE E S SW
## 81 82 72 61 62
##
## [[72]]
## W NW N NE E SE S SW
## 71 81 82 83 73 61 62 63
##
## [[73]]
## W NW N NE E SE S SW
## 72 82 83 84 74 62 63 64
##
## [[74]]
## W NW N NE E SE S SW
## 73 83 84 85 75 63 64 65
##
## [[75]]
## W NW N NE E SE S SW
## 74 84 85 86 76 64 65 66
##
## [[76]]
## W NW N NE E SE S SW
## 75 85 86 87 77 65 66 67
##
## [[77]]
## W NW N NE E SE S SW
## 76 86 87 88 78 66 67 68
##
## [[78]]
## W NW N NE E SE S SW
## 77 87 88 89 79 67 68 69
##
## [[79]]
## W NW N NE E SE S SW
## 78 88 89 90 80 68 69 70
##
## [[80]]
## W NW N SE S
## 79 89 90 69 70
##
## [[81]]
## N NE E S SW
## 91 92 82 71 72
##
## [[82]]
## W NW N NE E SE S SW
## 81 91 92 93 83 71 72 73
##
## [[83]]
## W NW N NE E SE S SW
## 82 92 93 94 84 72 73 74
##
## [[84]]
## W NW N NE E SE S SW
## 83 93 94 95 85 73 74 75
##
## [[85]]
## W NW N NE E SE S SW
## 84 94 95 96 86 74 75 76
##
## [[86]]
## W NW N NE E SE S SW
## 85 95 96 97 87 75 76 77
##
## [[87]]
## W NW N NE E SE S SW
## 86 96 97 98 88 76 77 78
##
## [[88]]
## W NW N NE E SE S SW
## 87 97 98 99 89 77 78 79
##
## [[89]]
## W NW N NE E SE S SW
## 88 98 99 100 90 78 79 80
##
## [[90]]
## W NW N SE S
## 89 99 100 79 80
##
## [[91]]
## E S SW
## 92 81 82
##
## [[92]]
## W E SE S SW
## 91 93 81 82 83
##
## [[93]]
## W E SE S SW
## 92 94 82 83 84
##
## [[94]]
## W E SE S SW
## 93 95 83 84 85
##
## [[95]]
## W E SE S SW
## 94 96 84 85 86
##
## [[96]]
## W E SE S SW
## 95 97 85 86 87
##
## [[97]]
## W E SE S SW
## 96 98 86 87 88
##
## [[98]]
## W E SE S SW
## 97 99 87 88 89
##
## [[99]]
## W E SE S SW
## 98 100 88 89 90
##
## [[100]]
## W SE S
## 99 89 90
g1 <- graph(edges = rev(getEdges(figure10.2,FALSE)),
directed = F, n = 100)
plot(g1, layout=layout_on_grid)figure10.2.adj <- adjlist.adaptive(figure10.2)
figure10.2.adj## [[1]]
## NA
## NA
##
## [[2]]
## NULL
##
## [[3]]
## NA
## NA
##
## [[4]]
## N NE
## 14 15
##
## [[5]]
## NA
## NA
##
## [[6]]
## NA
## NA
##
## [[7]]
## E
## 8
##
## [[8]]
## W
## 7
##
## [[9]]
## NA
## NA
##
## [[10]]
## NA
## NA
##
## [[11]]
## NA
## NA
##
## [[12]]
## NA
## NA
##
## [[13]]
## NA
## NA
##
## [[14]]
## E S
## 15 4
##
## [[15]]
## W NE SE
## 14 26 4
##
## [[16]]
## NA
## NA
##
## [[17]]
## NA
## NA
##
## [[18]]
## NA
## NA
##
## [[19]]
## NA
## NA
##
## [[20]]
## NA
## NA
##
## [[21]]
## NA
## NA
##
## [[22]]
## NE
## 33
##
## [[23]]
## NA
## NA
##
## [[24]]
## NA
## NA
##
## [[25]]
## NA
## NA
##
## [[26]]
## N SE
## 36 15
##
## [[27]]
## NA
## NA
##
## [[28]]
## NA
## NA
##
## [[29]]
## NW
## 38
##
## [[30]]
## NA
## NA
##
## [[31]]
## NA
## NA
##
## [[32]]
## NA
## NA
##
## [[33]]
## NW NE SE
## 42 44 22
##
## [[34]]
## NA
## NA
##
## [[35]]
## NA
## NA
##
## [[36]]
## S
## 26
##
## [[37]]
## NA
## NA
##
## [[38]]
## SW
## 29
##
## [[39]]
## NA
## NA
##
## [[40]]
## NA
## NA
##
## [[41]]
## NA
## NA
##
## [[42]]
## SW
## 33
##
## [[43]]
## NA
## NA
##
## [[44]]
## N SE
## 54 33
##
## [[45]]
## NA
## NA
##
## [[46]]
## NA
## NA
##
## [[47]]
## NA
## NA
##
## [[48]]
## NA
## NA
##
## [[49]]
## NA
## NA
##
## [[50]]
## NA
## NA
##
## [[51]]
## NA
## NA
##
## [[52]]
## NA
## NA
##
## [[53]]
## NA
## NA
##
## [[54]]
## S
## 44
##
## [[55]]
## NA
## NA
##
## [[56]]
## NULL
##
## [[57]]
## NA
## NA
##
## [[58]]
## NA
## NA
##
## [[59]]
## NULL
##
## [[60]]
## NA
## NA
##
## [[61]]
## E
## 62
##
## [[62]]
## W
## 61
##
## [[63]]
## NA
## NA
##
## [[64]]
## NA
## NA
##
## [[65]]
## NA
## NA
##
## [[66]]
## NA
## NA
##
## [[67]]
## NA
## NA
##
## [[68]]
## NA
## NA
##
## [[69]]
## NA
## NA
##
## [[70]]
## NA
## NA
##
## [[71]]
## NA
## NA
##
## [[72]]
## NA
## NA
##
## [[73]]
## NA
## NA
##
## [[74]]
## NW N E
## 83 84 75
##
## [[75]]
## W NW
## 74 84
##
## [[76]]
## NA
## NA
##
## [[77]]
## NA
## NA
##
## [[78]]
## NE E
## 89 79
##
## [[79]]
## W N NE
## 78 89 90
##
## [[80]]
## NA
## NA
##
## [[81]]
## N
## 91
##
## [[82]]
## NA
## NA
##
## [[83]]
## E SW
## 84 74
##
## [[84]]
## W S SW
## 83 74 75
##
## [[85]]
## NA
## NA
##
## [[86]]
## NA
## NA
##
## [[87]]
## NA
## NA
##
## [[88]]
## NA
## NA
##
## [[89]]
## NE E SE S
## 100 90 78 79
##
## [[90]]
## W N SE
## 89 100 79
##
## [[91]]
## S
## 81
##
## [[92]]
## NA
## NA
##
## [[93]]
## NA
## NA
##
## [[94]]
## NA
## NA
##
## [[95]]
## NA
## NA
##
## [[96]]
## NA
## NA
##
## [[97]]
## NA
## NA
##
## [[98]]
## NA
## NA
##
## [[99]]
## NA
## NA
##
## [[100]]
## SE S
## 89 90
g2 <- graph(edges = rev(getEdges(figure10.2,TRUE)),
directed = F, n = 100)
plot(g2, layout=layout_on_grid)g1 <- graph(edges = rev(getEdges(figure10.2,FALSE)),
directed = F, n = 100)
plot(g1, layout=layout_on_grid)## [[1]]
## N NE E
## 11 12 2
##
## [[2]]
## W NW N NE E
## 1 11 12 13 3
##
## [[3]]
## W NW N NE E
## 2 12 13 14 4
##
## [[4]]
## W NW N NE E
## 3 13 14 15 5
##
## [[5]]
## W NW N NE E
## 4 14 15 16 6
##
## [[6]]
## W NW N NE E
## 5 15 16 17 7
##
## [[7]]
## W NW N NE E
## 6 16 17 18 8
##
## [[8]]
## W NW N NE E
## 7 17 18 19 9
##
## [[9]]
## W NW N NE E
## 8 18 19 20 10
##
## [[10]]
## W NW N
## 9 19 20
##
## [[11]]
## N NE E S SW
## 21 22 12 1 2
##
## [[12]]
## W NW N NE E SE S SW
## 11 21 22 23 13 1 2 3
##
## [[13]]
## W NW N NE E SE S SW
## 12 22 23 24 14 2 3 4
##
## [[14]]
## W NW N NE E SE S SW
## 13 23 24 25 15 3 4 5
##
## [[15]]
## W NW N NE E SE S SW
## 14 24 25 26 16 4 5 6
##
## [[16]]
## W NW N NE E SE S SW
## 15 25 26 27 17 5 6 7
##
## [[17]]
## W NW N NE E SE S SW
## 16 26 27 28 18 6 7 8
##
## [[18]]
## W NW N NE E SE S SW
## 17 27 28 29 19 7 8 9
##
## [[19]]
## W NW N NE E SE S SW
## 18 28 29 30 20 8 9 10
##
## [[20]]
## W NW N SE S
## 19 29 30 9 10
##
## [[21]]
## N NE E S SW
## 31 32 22 11 12
##
## [[22]]
## W NW N NE E SE S SW
## 21 31 32 33 23 11 12 13
##
## [[23]]
## W NW N NE E SE S SW
## 22 32 33 34 24 12 13 14
##
## [[24]]
## W NW N NE E SE S SW
## 23 33 34 35 25 13 14 15
##
## [[25]]
## W NW N NE E SE S SW
## 24 34 35 36 26 14 15 16
##
## [[26]]
## W NW N NE E SE S SW
## 25 35 36 37 27 15 16 17
##
## [[27]]
## W NW N NE E SE S SW
## 26 36 37 38 28 16 17 18
##
## [[28]]
## W NW N NE E SE S SW
## 27 37 38 39 29 17 18 19
##
## [[29]]
## W NW N NE E SE S SW
## 28 38 39 40 30 18 19 20
##
## [[30]]
## W NW N SE S
## 29 39 40 19 20
##
## [[31]]
## N NE E S SW
## 41 42 32 21 22
##
## [[32]]
## W NW N NE E SE S SW
## 31 41 42 43 33 21 22 23
##
## [[33]]
## W NW N NE E SE S SW
## 32 42 43 44 34 22 23 24
##
## [[34]]
## W NW N NE E SE S SW
## 33 43 44 45 35 23 24 25
##
## [[35]]
## W NW N NE E SE S SW
## 34 44 45 46 36 24 25 26
##
## [[36]]
## W NW N NE E SE S SW
## 35 45 46 47 37 25 26 27
##
## [[37]]
## W NW N NE E SE S SW
## 36 46 47 48 38 26 27 28
##
## [[38]]
## W NW N NE E SE S SW
## 37 47 48 49 39 27 28 29
##
## [[39]]
## W NW N NE E SE S SW
## 38 48 49 50 40 28 29 30
##
## [[40]]
## W NW N SE S
## 39 49 50 29 30
##
## [[41]]
## N NE E S SW
## 51 52 42 31 32
##
## [[42]]
## W NW N NE E SE S SW
## 41 51 52 53 43 31 32 33
##
## [[43]]
## W NW N NE E SE S SW
## 42 52 53 54 44 32 33 34
##
## [[44]]
## W NW N NE E SE S SW
## 43 53 54 55 45 33 34 35
##
## [[45]]
## W NW N NE E SE S SW
## 44 54 55 56 46 34 35 36
##
## [[46]]
## W NW N NE E SE S SW
## 45 55 56 57 47 35 36 37
##
## [[47]]
## W NW N NE E SE S SW
## 46 56 57 58 48 36 37 38
##
## [[48]]
## W NW N NE E SE S SW
## 47 57 58 59 49 37 38 39
##
## [[49]]
## W NW N NE E SE S SW
## 48 58 59 60 50 38 39 40
##
## [[50]]
## W NW N SE S
## 49 59 60 39 40
##
## [[51]]
## N NE E S SW
## 61 62 52 41 42
##
## [[52]]
## W NW N NE E SE S SW
## 51 61 62 63 53 41 42 43
##
## [[53]]
## W NW N NE E SE S SW
## 52 62 63 64 54 42 43 44
##
## [[54]]
## W NW N NE E SE S SW
## 53 63 64 65 55 43 44 45
##
## [[55]]
## W NW N NE E SE S SW
## 54 64 65 66 56 44 45 46
##
## [[56]]
## W NW N NE E SE S SW
## 55 65 66 67 57 45 46 47
##
## [[57]]
## W NW N NE E SE S SW
## 56 66 67 68 58 46 47 48
##
## [[58]]
## W NW N NE E SE S SW
## 57 67 68 69 59 47 48 49
##
## [[59]]
## W NW N NE E SE S SW
## 58 68 69 70 60 48 49 50
##
## [[60]]
## W NW N SE S
## 59 69 70 49 50
##
## [[61]]
## N NE E S SW
## 71 72 62 51 52
##
## [[62]]
## W NW N NE E SE S SW
## 61 71 72 73 63 51 52 53
##
## [[63]]
## W NW N NE E SE S SW
## 62 72 73 74 64 52 53 54
##
## [[64]]
## W NW N NE E SE S SW
## 63 73 74 75 65 53 54 55
##
## [[65]]
## W NW N NE E SE S SW
## 64 74 75 76 66 54 55 56
##
## [[66]]
## W NW N NE E SE S SW
## 65 75 76 77 67 55 56 57
##
## [[67]]
## W NW N NE E SE S SW
## 66 76 77 78 68 56 57 58
##
## [[68]]
## W NW N NE E SE S SW
## 67 77 78 79 69 57 58 59
##
## [[69]]
## W NW N NE E SE S SW
## 68 78 79 80 70 58 59 60
##
## [[70]]
## W NW N SE S
## 69 79 80 59 60
##
## [[71]]
## N NE E S SW
## 81 82 72 61 62
##
## [[72]]
## W NW N NE E SE S SW
## 71 81 82 83 73 61 62 63
##
## [[73]]
## W NW N NE E SE S SW
## 72 82 83 84 74 62 63 64
##
## [[74]]
## W NW N NE E SE S SW
## 73 83 84 85 75 63 64 65
##
## [[75]]
## W NW N NE E SE S SW
## 74 84 85 86 76 64 65 66
##
## [[76]]
## W NW N NE E SE S SW
## 75 85 86 87 77 65 66 67
##
## [[77]]
## W NW N NE E SE S SW
## 76 86 87 88 78 66 67 68
##
## [[78]]
## W NW N NE E SE S SW
## 77 87 88 89 79 67 68 69
##
## [[79]]
## W NW N NE E SE S SW
## 78 88 89 90 80 68 69 70
##
## [[80]]
## W NW N SE S
## 79 89 90 69 70
##
## [[81]]
## N NE E S SW
## 91 92 82 71 72
##
## [[82]]
## W NW N NE E SE S SW
## 81 91 92 93 83 71 72 73
##
## [[83]]
## W NW N NE E SE S SW
## 82 92 93 94 84 72 73 74
##
## [[84]]
## W NW N NE E SE S SW
## 83 93 94 95 85 73 74 75
##
## [[85]]
## W NW N NE E SE S SW
## 84 94 95 96 86 74 75 76
##
## [[86]]
## W NW N NE E SE S SW
## 85 95 96 97 87 75 76 77
##
## [[87]]
## W NW N NE E SE S SW
## 86 96 97 98 88 76 77 78
##
## [[88]]
## W NW N NE E SE S SW
## 87 97 98 99 89 77 78 79
##
## [[89]]
## W NW N NE E SE S SW
## 88 98 99 100 90 78 79 80
##
## [[90]]
## W NW N SE S
## 89 99 100 79 80
##
## [[91]]
## E S SW
## 92 81 82
##
## [[92]]
## W E SE S SW
## 91 93 81 82 83
##
## [[93]]
## W E SE S SW
## 92 94 82 83 84
##
## [[94]]
## W E SE S SW
## 93 95 83 84 85
##
## [[95]]
## W E SE S SW
## 94 96 84 85 86
##
## [[96]]
## W E SE S SW
## 95 97 85 86 87
##
## [[97]]
## W E SE S SW
## 96 98 86 87 88
##
## [[98]]
## W E SE S SW
## 97 99 87 88 89
##
## [[99]]
## W E SE S SW
## 98 100 88 89 90
##
## [[100]]
## W SE S
## 99 89 90
g2 <- graph(edges = rev(getEdges(figure10.2,TRUE)),
directed = F, n = 100)
plot(g2, layout=layout_on_grid)## [[1]]
## NA
## NA
##
## [[2]]
## NULL
##
## [[3]]
## NA
## NA
##
## [[4]]
## N NE
## 14 15
##
## [[5]]
## NA
## NA
##
## [[6]]
## NA
## NA
##
## [[7]]
## E
## 8
##
## [[8]]
## W
## 7
##
## [[9]]
## NA
## NA
##
## [[10]]
## NA
## NA
##
## [[11]]
## NA
## NA
##
## [[12]]
## NA
## NA
##
## [[13]]
## NA
## NA
##
## [[14]]
## E S
## 15 4
##
## [[15]]
## W NE SE
## 14 26 4
##
## [[16]]
## NA
## NA
##
## [[17]]
## NA
## NA
##
## [[18]]
## NA
## NA
##
## [[19]]
## NA
## NA
##
## [[20]]
## NA
## NA
##
## [[21]]
## NA
## NA
##
## [[22]]
## NE
## 33
##
## [[23]]
## NA
## NA
##
## [[24]]
## NA
## NA
##
## [[25]]
## NA
## NA
##
## [[26]]
## N SE
## 36 15
##
## [[27]]
## NA
## NA
##
## [[28]]
## NA
## NA
##
## [[29]]
## NW
## 38
##
## [[30]]
## NA
## NA
##
## [[31]]
## NA
## NA
##
## [[32]]
## NA
## NA
##
## [[33]]
## NW NE SE
## 42 44 22
##
## [[34]]
## NA
## NA
##
## [[35]]
## NA
## NA
##
## [[36]]
## S
## 26
##
## [[37]]
## NA
## NA
##
## [[38]]
## SW
## 29
##
## [[39]]
## NA
## NA
##
## [[40]]
## NA
## NA
##
## [[41]]
## NA
## NA
##
## [[42]]
## SW
## 33
##
## [[43]]
## NA
## NA
##
## [[44]]
## N SE
## 54 33
##
## [[45]]
## NA
## NA
##
## [[46]]
## NA
## NA
##
## [[47]]
## NA
## NA
##
## [[48]]
## NA
## NA
##
## [[49]]
## NA
## NA
##
## [[50]]
## NA
## NA
##
## [[51]]
## NA
## NA
##
## [[52]]
## NA
## NA
##
## [[53]]
## NA
## NA
##
## [[54]]
## S
## 44
##
## [[55]]
## NA
## NA
##
## [[56]]
## NULL
##
## [[57]]
## NA
## NA
##
## [[58]]
## NA
## NA
##
## [[59]]
## NULL
##
## [[60]]
## NA
## NA
##
## [[61]]
## E
## 62
##
## [[62]]
## W
## 61
##
## [[63]]
## NA
## NA
##
## [[64]]
## NA
## NA
##
## [[65]]
## NA
## NA
##
## [[66]]
## NA
## NA
##
## [[67]]
## NA
## NA
##
## [[68]]
## NA
## NA
##
## [[69]]
## NA
## NA
##
## [[70]]
## NA
## NA
##
## [[71]]
## NA
## NA
##
## [[72]]
## NA
## NA
##
## [[73]]
## NA
## NA
##
## [[74]]
## NW N E
## 83 84 75
##
## [[75]]
## W NW
## 74 84
##
## [[76]]
## NA
## NA
##
## [[77]]
## NA
## NA
##
## [[78]]
## NE E
## 89 79
##
## [[79]]
## W N NE
## 78 89 90
##
## [[80]]
## NA
## NA
##
## [[81]]
## N
## 91
##
## [[82]]
## NA
## NA
##
## [[83]]
## E SW
## 84 74
##
## [[84]]
## W S SW
## 83 74 75
##
## [[85]]
## NA
## NA
##
## [[86]]
## NA
## NA
##
## [[87]]
## NA
## NA
##
## [[88]]
## NA
## NA
##
## [[89]]
## NE E SE S
## 100 90 78 79
##
## [[90]]
## W N SE
## 89 100 79
##
## [[91]]
## S
## 81
##
## [[92]]
## NA
## NA
##
## [[93]]
## NA
## NA
##
## [[94]]
## NA
## NA
##
## [[95]]
## NA
## NA
##
## [[96]]
## NA
## NA
##
## [[97]]
## NA
## NA
##
## [[98]]
## NA
## NA
##
## [[99]]
## NA
## NA
##
## [[100]]
## SE S
## 89 90
A Queue is essentially a fancy vector
Add things to the back of the Queue (“push”)
Remove things from the front of the Queue (“dequeue”)
Queue <- setRefClass(Class = "Queue",
fields = list(
name = "character",
data = "list"
),
methods = list(
size = function() {
'Returns the number of items in the queue.'
return(length(data))
},
#
push = function(item) {
'Inserts element at back of the queue.'
data[[size()+1]] <<- item
},
#
pop = function() {
'Removes and returns head of queue (or raises error if queue is empty).'
if (size() == 0) stop("queue is empty!")
value <- data[[1]]
data[[1]] <<- NULL
value
},
#
initialize=function(...) {
callSuper(...)
#
# Initialise fields here (place holder)...
#
.self
},
empty=function(...){
return(size() == 0)
}
)
)Graph theory & computer science to the rescue!
Algorithm: Breadth First Search (BFS)
- BFS (V,E,s) {
- for each u within V - {s}
- u.distance <- inf
- u.parent <- u
- s.d <- 0
- Q <- 0
- Enqueue(Q,s)
- while Q is not empty
- u <- Dequeue(Q)
- for each v within G.adj[u]
- if v.d == inf
- v.d = u.d + 1
- v.parent = u
- Enqueue(Q,v)
- }
“V” the vertices of the graph
“E” the adjlist for that graph
“s” the ID of the vertex to start the BFS on
“u” some vertex either adjacent to s or s itself, or adjacent to a vertex adjacent to s etc.
BFS <- function(V,G.adj,s){
d <- rep(0,nrow(V)*ncol(V))
p <- rep(0,nrow(V)*ncol(V))
for(u in 1:length(V)){
d[u] <- -1
p[u] <- u
}
d[s] <- 0
Q <- Queue$new()
Q$push(s)
id <- c()
while(!Q$empty()){
u <- Q$pop()
id <- c(id,u)
if(!is.na(G.adj[u])){
for(v in G.adj[[u]]){
if(d[v] == -1){
d[v] <- d[u] + 1
p[v] <- u
Q$push(v)
}
}
}
}
return(list("adaptive.sample" = data.frame("y" = sum(V[d != -1]),"m" = length(d[d != -1])),
"sampled.squares" = data.frame("id" = id, "yi" = V[id]),
"d" = matrix(d, nrow = nrow(V), ncol=ncol(V)),
"p" = matrix(p, nrow = nrow(V), ncol=ncol(V))))
}\(S = 83\) The idea is that after a BFS Traversal of the graph from some node s any visited square will have a distance != \(inf\)
All of the visited squares have a value != -1 aka infinity
\(s = 97\)
All of the visited squares have a value != -1 (infinity)
The value of \(-1\) means that there is an “infinite distance” between the two vertices, aka we cannot get there from where we are
adaptive.sample <- function(world, vertecies){
world.adj <- adjlist.adaptive(world)
samples <- data.frame("y" = numeric(0),"m" = numeric(0))
for(i in vertecies){
samples <- rbind(samples,BFS(world,world.adj,i)$adaptive.sample)
}
return(samples)
}
adaptive.sample.figure10.2 <- adaptive.sample(figure10.2,
c(97,83,56,44,39))
adaptive.sample.figure10.2## y m
## 1 0 1
## 2 12 4
## 3 1 1
## 4 15 5
## 5 0 1
adaptive.sample.confint.fun(adaptive.sample.figure10.2$y,
adaptive.sample.figure10.2$m,
nrow(adaptive.sample.figure10.2),
nrow(figure10.2)*ncol(figure10.2)
)[c("mu.hat","v.mu","lower","upper")]## mu.hat v.mu lower upper
## 1.40000000 0.43700000 0.07788049 2.72211951
Each individual BFS:
bfs.97 <- BFS(figure10.2,figure10.2.adj,97)
bfs.97$adaptive.sample## y m
## 1 0 1
bfs.97$sampled.squares## id yi
## 1 97 0
bfs.83 <- BFS(figure10.2,figure10.2.adj,83)
bfs.83$adaptive.sample## y m
## 1 12 4
bfs.83$sampled.squares## id yi
## 1 83 2
## 2 84 1
## 3 74 4
## 4 75 5
bfs.56 <- BFS(figure10.2,figure10.2.adj,56)
bfs.56$adaptive.sample## y m
## 1 1 1
bfs.56$sampled.squares## id yi
## 1 56 1
bfs.44 <- BFS(figure10.2,figure10.2.adj,44)
bfs.44$adaptive.sample## y m
## 1 15 5
bfs.44$sampled.squares## id yi
## 1 44 4
## 2 54 2
## 3 33 3
## 4 42 5
## 5 22 1
bfs.29 <- BFS(figure10.2,figure10.2.adj,29)
bfs.29$adaptive.sample## y m
## 1 7 2
bfs.29$sampled.squares## id yi
## 1 29 4
## 2 38 3
## id yi BFS
## 1 97 0 1
## 2 83 2 2
## 3 84 1 2
## 4 74 4 2
## 5 75 5 2
## 6 56 1 3
## 7 44 4 4
## 8 54 2 4
## 9 33 3 4
## 10 42 5 4
## 11 22 1 4
## 12 29 4 5
## 13 38 3 5
set.seed(58039847)
nrow <- 15
ncol <- 30
world.15.30 <- matrix(sample(c(rep(0,25),c(1:10)),
nrow*ncol,
replace = TRUE),
nrow,ncol, byrow = TRUE)world.15.30.adj <- adjlist.adaptive(world.15.30)
interesting.squares <- c(1,13,53,57,128,227,241,280,358)
adaptive.sample(world.15.30,interesting.squares)## y m
## 1 0 1
## 2 104 19
## 3 39 8
## 4 45 7
## 5 64 10
## 6 55 12
## 7 105 17
## 8 8 1
## 9 49 9
set.seed(NULL) ## randomize the seed again
nrow <- sample(50:100,1)
ncol <- sample(50:100,1)
world <- matrix(sample(c(rep(0,25),c(1:10)),nrow*ncol,replace = TRUE),
nrow = nrow,ncol = ncol,byrow=TRUE)squares.to.sample <- c(sample(which(as.vector(world)!=0),30),
sample(which(as.vector(world)==0),30))
adaptive.samples <- adaptive.sample(world, squares.to.sample)
sampled.squares <- get.sampled.squares(world,squares.to.sample)adaptive.sample.confint.fun(adaptive.samples$y,
adaptive.samples$m,
nrow(adaptive.samples),
nrow(world)*ncol(world))## mu.hat s.y.2 v.mu var lower upper
## 2.8468930 8.9417242 0.1475729 0.7683044 2.0785886 3.6151974